home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue49 / Alfresco / TstBinTr.dpr < prev   
Encoding:
Text File  |  1999-07-25  |  5.9 KB  |  236 lines
  1. program TstBinTr;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils,
  7.   Classes,
  8.   AABinTre in 'AABinTre.pas',
  9.   PSProcs in 'PSProcs.pas';
  10.  
  11. const
  12.   ColumnWidth = 25;
  13.   StripHeight = 25;
  14.   MarginLeft  = 20;
  15.  
  16. type
  17.   PMyRec = ^TMyRec;
  18.   TMyRec = packed record
  19.     Name : string[31];
  20.     Age  : integer;
  21.   end;
  22.  
  23. function CompareMyRec(aItem1, aItem2 : pointer) : integer;
  24. var
  25.   MyRec1 : PMyRec absolute aItem1;
  26.   MyRec2 : PMyRec absolute aItem2;
  27. begin
  28.   if (MyRec1.Name < MyRec2.Name) then
  29.     Result := -1
  30.   else if (MyRec1.Name > MyRec2.Name) then
  31.     Result := 1
  32.   else
  33.     Result := MyRec1.Age - MyRec2.Age;
  34. end;
  35.  
  36. procedure RandomMyRec(var MyRec : TMyRec);
  37. var
  38.   i : integer;
  39. begin
  40.   MyRec.Name[0] := #3 {char(Random(3) + 1)};
  41.   for i := 1 to length(MyRec.Name) do
  42.     MyRec.Name[i] := char(Random(26) + ord('a'));
  43.   MyRec.Age := Random(20) + 30;
  44. end;
  45.  
  46. procedure DisposeMyRec(aItem : pointer);
  47. begin
  48.   Dispose(PMyRec(aItem));
  49. end;
  50.  
  51. function PrintItem(aNode      : PaaBTNode;
  52.                    aExtraData : pointer) : boolean;
  53. begin
  54.   writeln(PMyRec(aNode^.btData)^.Name);
  55.   Result := true;
  56. end;
  57.  
  58. procedure DrawNode(aNode   : PaaBTNode;
  59.                    aStrip  : integer;
  60.                    aColumn : integer;
  61.                    aParentStrip  : integer;
  62.                    aParentColumn : integer;
  63.                    aExtraData    : pointer); far;
  64. var
  65.   X, Y : integer;
  66.   ParentX, ParentY : integer;
  67.   HasParent : boolean;
  68. begin
  69.   {calculate the X, Y position of the bottom left corner of the box}
  70.   X := MarginLeft + aColumn * ColumnWidth;
  71.   Y := 720 - (aStrip * StripHeight);
  72.   {do the same for the parent box}
  73.   if (aParentStrip = -1) then begin
  74.     HasParent := false;
  75.     ParentX := -1;
  76.     ParentY := -1;
  77.   end
  78.   else begin
  79.     HasParent := true;
  80.     ParentX := MarginLeft + aParentColumn * ColumnWidth;
  81.     ParentY := 720 - (aParentStrip * StripHeight);
  82.   end;
  83.   {draw the box for the node}
  84.   AAPSDrawRect(TStringList(aExtraData),
  85.                X, Y, ColumnWidth, StripHeight - 10);
  86.   {draw the text for the node}
  87.   AAPSDrawText(TStringList(aExtraData),
  88.                PMyRec(aNode^.btData)^.Name,
  89.                X+3, Y+5, 10);
  90.   {draw a line from our parent to ourselves}
  91.   if HasParent then begin
  92.     AAPSDrawLine(TStringList(aExtraData),
  93.                  ParentX + (ColumnWidth div 2),
  94.                  ParentY,
  95.                  X + (ColumnWidth div 2),
  96.                  Y + (StripHeight - 10));
  97.   end;
  98. end;
  99.  
  100.  
  101. procedure DrawTestTree(aBinTree : TaaBinarySearchTree;
  102.                        aID      : integer);
  103. var
  104.   SList : TStringList;
  105. begin
  106.   SList := TStringList.Create;
  107.   try
  108.     AAPSOutputProlog(SList);
  109.     DrawBinaryTree(aBinTree, DrawNode, pointer(SList));
  110.     AAPSOutputEpilog(SList);
  111.     SList.SaveToFile(Format('BinTre%d.EPS', [aID]));
  112.   finally
  113.     SList.Free;
  114.   end;
  115. end;
  116.  
  117. const
  118.   NodeCount = 15;
  119. var
  120.   BinTree : TaaBinarySearchTree;
  121.   MyRec   : PMyRec;
  122.   i       : integer;
  123.   MyRecQuery : TMyRec;
  124. begin
  125.   writeln('Testing binary tree...');
  126.   try
  127.     BinTree := TaaBinarySearchTree.Create(CompareMyRec, DisposeMyRec);
  128.     try
  129.       writeln('inserting');
  130.       RandSeed := $12345678;
  131.       for i := 1 to NodeCount do begin
  132.         New(MyRec);
  133.         RandomMyRec(MyRec^);
  134.         BinTree.Insert(MyRec);
  135.         DrawTestTree(BinTree, i);
  136.       end;
  137.       writeln('--pre-order');
  138.       BinTree.Traverse(tmPreOrder, PrintItem, nil, true);
  139.       readln;
  140.       writeln('--in-order');
  141.       BinTree.Traverse(tmInOrder, PrintItem, nil, true);
  142.       readln;
  143.       writeln('--post-order');
  144.       BinTree.Traverse(tmPostOrder, PrintItem, nil, true);
  145.       readln;
  146.       writeln('--level-order');
  147.       BinTree.Traverse(tmLevelOrder, PrintItem, nil, true);
  148.       readln;
  149.  
  150.       RandSeed := $12345678;
  151.       for i := 1 to NodeCount do begin
  152.         RandomMyRec(MyRecQuery);
  153.         MyRec := BinTree.Find(@MyRecQuery);
  154.         if (MyRec = nil) or (MyRec^.Name <> MyRecQuery.Name) then
  155.           writeln('error: cannot find ', MyRecQuery.Name);
  156.       end;
  157.  
  158.       {generate degenerate trees}
  159.       BinTree.Clear;
  160.       New(MyRec);
  161.       MyRec^.Name := '  a ';
  162.       BinTree.Insert(MyRec);
  163.       New(MyRec);
  164.       MyRec^.Name := '  b ';
  165.       BinTree.Insert(MyRec);
  166.       New(MyRec);
  167.       MyRec^.Name := '  c ';
  168.       BinTree.Insert(MyRec);
  169.       New(MyRec);
  170.       MyRec^.Name := '  d ';
  171.       BinTree.Insert(MyRec);
  172.       New(MyRec);
  173.       MyRec^.Name := '  e ';
  174.       BinTree.Insert(MyRec);
  175.       New(MyRec);
  176.       MyRec^.Name := '  f ';
  177.       BinTree.Insert(MyRec);
  178.       DrawTestTree(BinTree, 90);
  179.  
  180.       BinTree.Clear;
  181.       New(MyRec);
  182.       MyRec^.Name := '  a ';
  183.       BinTree.Insert(MyRec);
  184.       New(MyRec);
  185.       MyRec^.Name := '  f ';
  186.       BinTree.Insert(MyRec);
  187.       New(MyRec);
  188.       MyRec^.Name := '  b ';
  189.       BinTree.Insert(MyRec);
  190.       New(MyRec);
  191.       MyRec^.Name := '  e ';
  192.       BinTree.Insert(MyRec);
  193.       New(MyRec);
  194.       MyRec^.Name := '  c ';
  195.       BinTree.Insert(MyRec);
  196.       New(MyRec);
  197.       MyRec^.Name := '  d ';
  198.       BinTree.Insert(MyRec);
  199.       DrawTestTree(BinTree, 91);
  200.  
  201.       {generate bushy tree}
  202.       BinTree.Clear;
  203.       New(MyRec);
  204.       MyRec^.Name := '  d ';
  205.       BinTree.Insert(MyRec);
  206.       New(MyRec);
  207.       MyRec^.Name := '  b ';
  208.       BinTree.Insert(MyRec);
  209.       New(MyRec);
  210.       MyRec^.Name := '  f ';
  211.       BinTree.Insert(MyRec);
  212.       New(MyRec);
  213.       MyRec^.Name := '  a ';
  214.       BinTree.Insert(MyRec);
  215.       New(MyRec);
  216.       MyRec^.Name := '  c ';
  217.       BinTree.Insert(MyRec);
  218.       New(MyRec);
  219.       MyRec^.Name := '  e ';
  220.       BinTree.Insert(MyRec);
  221.       New(MyRec);
  222.       MyRec^.Name := '  g ';
  223.       BinTree.Insert(MyRec);
  224.       DrawTestTree(BinTree, 92);
  225.  
  226.     finally
  227.       BinTree.Free;
  228.     end;
  229.   except
  230.     on E: Exception do
  231.       writeln(E.Message);
  232.   end;
  233.   writeln('Done');
  234.   readln;
  235. end.
  236.